home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Low Level Languages / FORTRAN.500 / DISK6 / ANIMATE.FO$ / ANIMATE.bin
Encoding:
Text File  |  1990-09-28  |  1.7 KB  |  63 lines
  1. CC  ANIMATE.FOR - Illustrates animation functions including:
  2. CC                imagesize     getimage     putimage
  3.  
  4.       INCLUDE  'FGRAPH.FI'
  5.       INCLUDE  'FGRAPH.FD'
  6.  
  7.       INTEGER*1        buffer[ALLOCATABLE] (:)
  8.       INTEGER*2        status, x, y, error, action(5)
  9.       INTEGER*4        imsize
  10.       CHARACTER*6      descrip(5)
  11.       RECORD /rccoord/ curpos
  12.  
  13.       DATA action  / $GPSET, $GPRESET, $GXOR, $GOR, $GAND  /
  14.       DATA descrip / 'PSET  ', 'PRESET', 'XOR  ', 'OR  ', 'AND  ' /
  15.  
  16. C
  17. C     Find graphics mode.
  18. C
  19.       IF( setvideomode( $MAXRESMODE ) .EQ. 0 ) 
  20.      +    STOP 'Error:  cannot set graphics mode'
  21.  
  22.       status = setcolor( 3 )
  23.       y     = 30
  24.       DO i = 1, 5
  25.          x = 50
  26.          y = y + 40
  27. C
  28. C        Display action type.
  29. C
  30.          CALL settextposition( 1, 1, curpos )
  31.          CALL outtext( descrip(i) )
  32. C
  33. C        Draw and measure ellipse, allocate memory for image.
  34. C
  35.          status  = ellipse( $GFILLINTERIOR, x - 15, y - 15, x + 15,
  36.      +                     y + 15 )
  37.          imsize = imagesize( x - 16, y - 16, x + 16, y + 16 )
  38.          ALLOCATE( buffer( imsize ), STAT = error )
  39.          IF( error .NE. 0 ) THEN
  40.             status = setvideomode( $DEFAULTMODE )
  41.             STOP 'Error:  insufficient memory'
  42.          END IF
  43. C
  44. C        Get master copy of ellipse.
  45. C
  46.          CALL getimage( x - 16, y - 16, x + 16, y + 16, buffer )
  47. C
  48. C        Copy row of ellipses with specified action.
  49. C
  50.          DO x = 55, 255, 5
  51.             CALL putimage( x - 16, y - 16, buffer, action(i) )
  52.          END DO
  53.  
  54. C
  55. C        Free memory, wait for ENTER key to continue.
  56. C
  57.          DEALLOCATE( buffer )
  58.          READ (*,*)
  59.       END DO
  60.  
  61.       status = setvideomode( $DEFAULTMODE )
  62.       END
  63.